home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / osr5 / devtools / dejagnu-971222 / usr / local / share / dejagnu / framework.exp < prev    next >
Encoding:
Text File  |  1998-03-22  |  18.0 KB  |  779 lines
  1. # Copyright (C) 92, 93, 94, 95, 1996, 1997 Free Software Foundation, Inc.
  2.  
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 2 of the License, or
  6. # (at your option) any later version.
  7. # 
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11. # GNU General Public License for more details.
  12. # 
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program; if not, write to the Free Software
  15. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16.  
  17. # Please email any bugs, comments, and/or additions to this file to:
  18. # bug-dejagnu@prep.ai.mit.edu
  19.  
  20. # This file was written by Rob Savoye. (rob@cygnus.com)
  21.  
  22. # These variables are local to this file.
  23. # This or more warnings and a test fails.
  24. set warning_threshold 3
  25. # This or more errors and a test fails.
  26. set perror_threshold 1
  27.  
  28. proc mail_file { file to subject } {
  29.     if [file readable $file] {
  30.     catch "exec mail -s \"$subject\" $to < $file"
  31.     }
  32. }
  33.  
  34. #
  35. # Open the output logs
  36. #
  37. proc open_logs { } {
  38.     global outdir
  39.     global tool
  40.     global sum_file
  41.     
  42.     if { ${tool} ==  "" } {
  43.     set tool testrun
  44.     }
  45.     catch "exec rm -f $outdir/$tool.sum"
  46.     set sum_file [open "$outdir/$tool.sum" w]
  47.     catch "exec rm -f $outdir/$tool.log"
  48.     log_file -a "$outdir/$tool.log"
  49.     verbose "Opening log files in $outdir"
  50.     if { ${tool} ==  "testrun" } {
  51.     set tool ""
  52.     }
  53. }
  54.  
  55.  
  56. #
  57. # Close the output logs
  58. #
  59. proc close_logs { } {
  60.     global sum_file
  61.     
  62.     catch "close $sum_file"
  63. }
  64.  
  65. #
  66. # Check build host triplet for pattern
  67. #
  68. # With no arguments it returns the triplet string.
  69. #
  70. proc isbuild { pattern } {
  71.     global build_triplet
  72.     global host_triplet
  73.     
  74.     if ![info exists build_triplet] {
  75.     set build_triplet ${host_triplet}
  76.     }
  77.     if [string match "" $pattern] {
  78.     return $build_triplet
  79.     }
  80.     verbose "Checking pattern \"$pattern\" with $build_triplet" 2
  81.     
  82.     if [string match "$pattern" $build_triplet] {
  83.     return 1
  84.     } else {
  85.     return 0
  86.     }
  87. }
  88.  
  89. #
  90. # Is $board remote? Return a non-zero value if so.
  91. #
  92. proc is_remote { board } {
  93.     global host_board;
  94.     global target_list;
  95.  
  96.     verbose "calling is_remote $board" 3;
  97.     # Remove any target variant specifications from the name.
  98.     set board [lindex [split $board "/"] 0];
  99.  
  100.     # Map the host or build back into their short form.
  101.     if { [board_info build name] == $board } {
  102.     set board "build";
  103.     } elseif { [board_info host name] == $board } {
  104.     set board "host";
  105.     }
  106.  
  107.     # We're on the "build". The check for the empty string is just for
  108.     # paranoia's sake--we shouldn't ever get one. "unix" is a magic
  109.     # string that should really go away someday.
  110.     if { $board == "build" || $board == "unix" || $board == "" } {
  111.     verbose "board is $board, not remote" 3;
  112.     return 0;
  113.     }
  114.  
  115.     if { $board == "host" } {
  116.     if { [info exists host_board] && $host_board != "" } {
  117.         verbose "board is $board, is remote" 3;
  118.         return 1;
  119.     } else {
  120.         verbose "board is $board, host is local" 3;
  121.         return 0;
  122.     }
  123.     }
  124.  
  125.     if { $board == "target" } {
  126.     global current_target_name
  127.  
  128.     if [info exists current_target_name] {
  129.         # This shouldn't happen, but we'll be paranoid anyway.
  130.         if { $current_target_name != "target" } {
  131.         return [is_remote $current_target_name];
  132.         }
  133.     }
  134.     return 0;
  135.     }
  136.     if [board_info $board exists isremote] {
  137.     verbose "board is $board, isremote is [board_info $board isremote]" 3;
  138.     return [board_info $board isremote];
  139.     }
  140.     return 1;
  141. }
  142. #
  143. # If this is a canadian (3 way) cross. This means the tools are
  144. # being built with a cross compiler for another host.
  145. #
  146. proc is3way {} {
  147.     global host_triplet
  148.     global build_triplet
  149.     
  150.     if ![info exists build_triplet] {
  151.     set build_triplet ${host_triplet}
  152.     }
  153.     verbose "Checking $host_triplet against $build_triplet" 2
  154.     if { "$build_triplet" == "$host_triplet" } {
  155.     return 0
  156.     }
  157.     return 1
  158. }
  159.  
  160. #
  161. # Check host triplet for pattern
  162. #
  163. # With no arguments it returns the triplet string.
  164. #
  165. proc ishost { pattern } {
  166.     global host_triplet
  167.     
  168.     if [string match "" $pattern] {
  169.     return $host_triplet
  170.     }
  171.     verbose "Checking pattern \"$pattern\" with $host_triplet" 2
  172.     
  173.     if [string match "$pattern" $host_triplet] {
  174.     return 1
  175.     } else {
  176.     return 0
  177.     }
  178. }
  179.  
  180. #
  181. # Check target triplet for pattern
  182. #
  183. # With no arguments it returns the triplet string.
  184. # Returns 1 if the target looked for, or 0 if not.
  185. #
  186. proc istarget { args } {
  187.     global target_triplet
  188.     
  189.     # if no arg, return the config string
  190.     if [string match "" $args] {
  191.     if [info exists target_triplet] {
  192.         return $target_triplet
  193.     } else {
  194.         perror "No target configuration names found."
  195.     }
  196.     }
  197.  
  198.     # now check against the cannonical name
  199.     if [info exists target_triplet] {
  200.     verbose "Checking \"$args\" against \"$target_triplet\"" 2
  201.     if [string match "$args" $target_triplet] {
  202.         return 1
  203.     }
  204.     }
  205.  
  206.     # nope, no match
  207.     return 0
  208. }
  209.  
  210. #
  211. # Check to see if we're running the tests in a native environment
  212. #
  213. # Returns 1 if running native, 0 if on a target.
  214. #
  215. proc isnative { } {
  216.     global target_triplet
  217.     global build_triplet
  218.     
  219.     if [string match $build_triplet $target_triplet] {
  220.     return 1
  221.     }
  222.     return 0
  223. }
  224.  
  225. #
  226. # unknown -- called by expect if a proc is called that doesn't exist
  227. #
  228. proc unknown { args } {
  229.     global errorCode
  230.     global errorInfo
  231.     global exit_status
  232.  
  233.     clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist."
  234.     if [info exists errorCode] {
  235.         send_error "The error code is $errorCode\n"
  236.     }
  237.     if [info exists errorInfo] {
  238.         send_error "The info on the error is:\n$errorInfo\n"
  239.     }
  240.  
  241.     set exit_status 1;
  242.     log_and_exit;
  243. }
  244.  
  245. #
  246. # Print output to stdout (or stderr) and to log file
  247. #
  248. # If the --all flag (-a) option was used then all messages go the the screen.
  249. # Without this, all messages that start with a keyword are written only to the
  250. # detail log file.  All messages that go to the screen will also appear in the
  251. # detail log.  This should only be used by the framework itself using pass,
  252. # fail, xpass, xfail, warning, perror, note, untested, unresolved, or
  253. # unsupported procedures.
  254. #
  255. proc clone_output { message } {
  256.     global sum_file
  257.     global all_flag
  258.     
  259.     if { $sum_file != "" } {
  260.     puts $sum_file "$message"
  261.     }
  262.  
  263.     regsub "^\[ \t\]*(\[^ \t\]+).*$" "$message" "\\1" firstword;
  264.     case "$firstword" in {
  265.     {"PASS:" "XFAIL:" "UNRESOLVED:" "UNSUPPORTED:" "UNTESTED:"} {
  266.         if $all_flag {
  267.         send_user "$message\n"
  268.         return "$message"
  269.         } else {
  270.         send_log "$message\n"
  271.         }
  272.     }
  273.     {"ERROR:" "WARNING:" "NOTE:"} {
  274.         send_error "$message\n"
  275.         return "$message"
  276.     }
  277.     default {
  278.         send_user "$message\n"
  279.         return "$message"
  280.     }
  281.     }
  282. }
  283.  
  284. #
  285. # Reset a few counters.
  286. #
  287. proc reset_vars {} {
  288.     global test_names test_counts;
  289.     global warncnt errcnt;
  290.  
  291.     # other miscellaneous variables
  292.     global prms_id
  293.     global bug_id
  294.     
  295.     # reset them all
  296.     set prms_id    0;
  297.     set bug_id    0;
  298.     set warncnt 0;
  299.     set errcnt  0;
  300.     foreach x $test_names {
  301.     set test_counts($x,count) 0;
  302.     }
  303.  
  304.     # Variables local to this file.
  305.     global warning_threshold perror_threshold
  306.     set warning_threshold 3
  307.     set perror_threshold 1
  308. }
  309.  
  310. proc log_and_exit {} {
  311.     global exit_status;
  312.     global tool mail_logs outdir mailing_list;
  313.  
  314.     log_summary total;
  315.     # extract version number
  316.     if {[info procs ${tool}_version] != ""} {
  317.     if {[catch "${tool}_version" output]} {
  318.         warning "${tool}_version failed:\n$output"
  319.     }
  320.     }
  321.     close_logs
  322.     cleanup
  323.     verbose -log "runtest completed at [timestamp -format %c]"
  324.     if $mail_logs {
  325.     mail_file $outdir/$tool.sum $mailing_list "Dejagnu Summary Log"
  326.     }
  327.     remote_close host
  328.     remote_close target
  329.     exit $exit_status
  330. }
  331. #
  332. # Print summary of all pass/fail counts
  333. #
  334. proc log_summary { args } {
  335.     global tool
  336.     global sum_file
  337.     global exit_status
  338.     global mail_logs
  339.     global outdir
  340.     global mailing_list
  341.     global current_target_name
  342.     global test_counts;
  343.     global testcnt;
  344.  
  345.     if { [llength $args] == 0 } {
  346.     set which "count";
  347.     } else {
  348.     set which [lindex $args 0];
  349.     }
  350.  
  351.     if { [llength $args] == 0 } {
  352.     clone_output "\n\t\t=== $tool Summary for $current_target_name ===\n"
  353.     } else {
  354.     clone_output "\n\t\t=== $tool Summary ===\n"
  355.     }
  356.  
  357.     # If the tool set `testcnt', it wants us to do a sanity check on the
  358.     # total count, so compare the reported number of testcases with the
  359.     # expected number.  Maintaining an accurate count in `testcnt' isn't easy
  360.     # so it's not clear how often this will be used.
  361.     if [info exists testcnt] {
  362.     if { $testcnt > 0 } {
  363.         set totlcnt 0;
  364.         # total all the testcases reported
  365.         foreach x { FAIL PASS XFAIL XPASS UNTESTED UNRESOLVED UNSUPPORTED } {
  366.         incr totlcnt test_counts($x,$which);
  367.         }
  368.         set testcnt test_counts(total,$which);
  369.         
  370.         if { $testcnt>$totlcnt || $testcnt<$totlcnt } {
  371.         if { $testcnt > $totlcnt } {
  372.             set mismatch "unreported  [expr $testcnt-$totlcnt]"
  373.         }
  374.         if { $testcnt < $totlcnt } {
  375.             set mismatch "misreported [expr $totlcnt-$testcnt]"
  376.         }
  377.         } else {
  378.         verbose "# of testcases run         $testcnt"
  379.         }
  380.  
  381.         if [info exists mismatch] {
  382.         clone_output "### ERROR: totals do not equal number of testcases run"
  383.         clone_output "### ERROR: # of testcases expected    $testcnt"
  384.         clone_output "### ERROR: # of testcases reported    $totlcnt"
  385.         clone_output "### ERROR: # of testcases $mismatch\n"
  386.         }
  387.     }
  388.     }
  389.     foreach x { PASS FAIL XPASS XFAIL UNRESOLVED UNTESTED UNSUPPORTED } {
  390.     set val $test_counts($x,$which);
  391.     if { $val > 0 } {
  392.         set mess "# of $test_counts($x,name)";
  393.         if { [string length $mess] < 24 } {
  394.         append mess "\t";
  395.         }
  396.         clone_output "$mess\t$val";
  397.     }
  398.     }
  399. }
  400.  
  401. #
  402. # Close all open files, remove temp file and core files
  403. #
  404. proc cleanup {} {
  405.     global sum_file
  406.     global exit_status
  407.     global done_list
  408.     global base_dir
  409.     global subdir
  410.     
  411.     #catch "exec rm -f [glob xgdb core *.x *.o *_soc a.out]"
  412.     #catch "exec rm -f [glob -nocomplain $subdir/*.o $subdir/*.x $subdir/*_soc]"
  413. }
  414.  
  415. #
  416. # Setup a flag to control whether a failure is expected or not
  417. #
  418. # Multiple target triplet patterns can be specified for targets
  419. # for which the test fails.  A decimal number can be specified,
  420. # which is the PRMS number.
  421. #
  422. proc setup_xfail { args } {
  423.     global xfail_flag
  424.     global xfail_prms
  425.     
  426.     set xfail_prms 0
  427.     set argc [ llength $args ]
  428.     for { set i 0 } { $i < $argc } { incr i } {
  429.     set sub_arg [ lindex $args $i ]
  430.     # is a prms number. we assume this is a number with no characters
  431.     if [regexp "^\[0-9\]+$" $sub_arg] { 
  432.         set xfail_prms $sub_arg
  433.         continue
  434.     }
  435.     if [istarget $sub_arg] {
  436.         set xfail_flag 1
  437.         continue
  438.     }
  439.     }
  440. }
  441.  
  442. #
  443. # Clear the xfail flag for a particular target
  444. #
  445. proc clear_xfail { args } {
  446.     global xfail_flag
  447.     global xfail_prms
  448.     
  449.     set argc [ llength $args ]
  450.     for { set i 0 } { $i < $argc } { incr i } {
  451.     set sub_arg [ lindex $args $i ]
  452.     case $sub_arg in {
  453.         "*-*-*" {            # is a configuration triplet
  454.         if [istarget $sub_arg] {
  455.             set xfail_flag 0
  456.             set xfail_prms 0
  457.         }
  458.         continue
  459.         }
  460.     }
  461.     }
  462. }
  463.  
  464. #
  465. # Record that a test has passed or failed (perhaps unexpectedly)
  466. #
  467. # This is an internal procedure, only used in this file.
  468. #
  469. proc record_test { type message args } {
  470.     global exit_status
  471.     global prms_id bug_id
  472.     global xfail_flag xfail_prms
  473.     global errcnt warncnt
  474.     global warning_threshold perror_threshold
  475.     global pf_prefix
  476.  
  477.     if { [llength $args] > 0 } {
  478.     set count [lindex $args 0];
  479.     } else {
  480.     set count 1;
  481.     }
  482.     if [info exists pf_prefix] {
  483.     set message [concat $pf_prefix " " $message];
  484.     }
  485.  
  486.     # If we have too many warnings or errors,
  487.     # the output of the test can't be considered correct.
  488.     if { $warning_threshold > 0 && $warncnt >= $warning_threshold
  489.      || $perror_threshold > 0 && $errcnt >= $perror_threshold } {
  490.     # Reset these first to prevent infinite recursion.
  491.     set warncnt 0
  492.     set errcnt  0
  493.     unresolved $message
  494.     return
  495.     }
  496.  
  497.     incr_count $type;
  498.  
  499.     switch $type {
  500.     PASS {
  501.         if $prms_id {
  502.         set message [concat $message "\t(PRMS $prms_id)"]
  503.         }
  504.     }
  505.     FAIL {
  506.         set exit_status 1
  507.         if $prms_id {
  508.         set message [concat $message "\t(PRMS $prms_id)"]
  509.         }
  510.     }
  511.     XPASS {
  512.         set exit_status 1
  513.         if { $xfail_prms != 0 } {
  514.         set message [concat $message "\t(PRMS $xfail_prms)"]
  515.         }
  516.     }
  517.     XFAIL {
  518.         if { $xfail_prms != 0 } {
  519.         set message [concat $message "\t(PRMS $xfail_prms)"]
  520.         }
  521.     }
  522.     UNTESTED {
  523.         # The only reason we look at the xfail stuff is to pick up
  524.         # `xfail_prms'.
  525.         if { $xfail_flag && $xfail_prms != 0 } {
  526.         set message [concat $message "\t(PRMS $xfail_prms)"]
  527.         } elseif $prms_id {
  528.         set message [concat $message "\t(PRMS $prms_id)"]
  529.         }
  530.     }
  531.     UNRESOLVED {
  532.         set exit_status 1
  533.         # The only reason we look at the xfail stuff is to pick up
  534.         # `xfail_prms'.
  535.         if { $xfail_flag && $xfail_prms != 0 } {
  536.         set message [concat $message "\t(PRMS $xfail_prms)"]
  537.         } elseif $prms_id {
  538.         set message [concat $message "\t(PRMS $prms_id)"]
  539.         }
  540.     }
  541.     UNSUPPORTED {
  542.         # The only reason we look at the xfail stuff is to pick up
  543.         # `xfail_prms'.
  544.         if { $xfail_flag && $xfail_prms != 0 } {
  545.         set message [concat $message "\t(PRMS $xfail_prms)"]
  546.         } elseif $prms_id {
  547.         set message [concat $message "\t(PRMS $prms_id)"]
  548.         }
  549.     }
  550.     default {
  551.         perror "record_test called with bad type `$type'"
  552.         set errcnt 0
  553.         return
  554.     }
  555.     }
  556.  
  557.     if $bug_id {
  558.     set message [concat $message "\t(BUG $bug_id)"]
  559.     }
  560.  
  561.     global multipass_name
  562.     if { $multipass_name != "" } {
  563.     clone_output "$type: $multipass_name: $message"
  564.     } else {
  565.     clone_output "$type: $message"
  566.     }
  567.     
  568.     # Reset these so they're ready for the next test case.  We don't reset
  569.     # prms_id or bug_id here.  There may be multiple tests for them.  Instead
  570.     # they are reset in the main loop after each test.  It is also the
  571.     # testsuite driver's responsibility to reset them after each testcase.
  572.     set warncnt 0
  573.     set errcnt 0
  574.     set xfail_flag 0
  575.     set xfail_prms 0
  576. }
  577.  
  578. #
  579. # Record that a test has passed
  580. #
  581. proc pass { message } {
  582.     global xfail_flag
  583.  
  584.     if $xfail_flag {
  585.     record_test XPASS $message
  586.     } else {
  587.     record_test PASS $message
  588.     }
  589. }
  590.  
  591. #
  592. # Record that a test has failed
  593. #
  594. proc fail { message } {
  595.     global xfail_flag
  596.  
  597.     if $xfail_flag {
  598.     record_test XFAIL $message
  599.     } else {
  600.     record_test FAIL $message
  601.     }
  602. }
  603.  
  604. #
  605. # Record that a test has passed unexpectedly
  606. #
  607. proc xpass { message } {
  608.     record_test XPASS $message
  609. }
  610.  
  611. #
  612. # Record that a test has failed unexpectedly
  613. #
  614. proc xfail { message } {
  615.     record_test XFAIL $message
  616. }
  617.  
  618. #
  619. # Set warning threshold
  620. #
  621. proc set_warning_threshold { threshold } {
  622.     set warning_threshold $threshold
  623. }
  624.  
  625. #
  626. # Get warning threshold
  627. #
  628. proc get_warning_threshold { } {
  629.     return $warning_threshold
  630. }
  631.  
  632. #
  633. # Prints warning messages
  634. # These are warnings from the framework, not from the tools being tested.
  635. # It takes a string, and an optional number and returns nothing.
  636. #
  637. proc warning { args } {
  638.     global warncnt
  639.  
  640.     if { [llength $args] > 1 } {
  641.     set warncnt [lindex $args 1]
  642.     } else {
  643.     incr warncnt
  644.     }
  645.     set message [lindex $args 0]
  646.     
  647.     clone_output "WARNING: $message"
  648.  
  649.     global errorInfo
  650.     if [info exists errorInfo] {
  651.     unset errorInfo
  652.     }
  653. }
  654.  
  655. #
  656. # Prints error messages
  657. # These are errors from the framework, not from the tools being tested. 
  658. # It takes a string, and an optional number and returns nothing.
  659. #
  660. proc perror { args } {
  661.     global errcnt
  662.  
  663.     if { [llength $args] > 1 } {
  664.     set errcnt [lindex $args 1]
  665.     } else {
  666.     incr errcnt
  667.     }
  668.     set message [lindex $args 0]
  669.     
  670.     clone_output "ERROR: $message"
  671.  
  672.     global errorInfo
  673.     if [info exists errorInfo] {
  674.     unset errorInfo
  675.     }
  676. }
  677.  
  678. #
  679. # Prints informational messages
  680. #
  681. # These are messages from the framework, not from the tools being tested.
  682. # This means that it is currently illegal to call this proc outside
  683. # of dejagnu proper.
  684. #
  685. proc note { message } {
  686.     clone_output "NOTE: $message"
  687.  
  688.     # ??? It's not clear whether we should do this.  Let's not, and only do
  689.     # so if we find a real need for it.
  690.     #global errorInfo
  691.     #if [info exists errorInfo] {
  692.     #    unset errorInfo
  693.     #}
  694. }
  695.  
  696. #
  697. # untested -- mark the test case as untested
  698. #
  699. proc untested { message } {
  700.     record_test UNTESTED $message
  701. }
  702.  
  703. #
  704. # Mark the test case as unresolved
  705. #
  706. proc unresolved { message } {
  707.     record_test UNRESOLVED $message
  708. }
  709.  
  710. #
  711. # Mark the test case as unsupported
  712. #
  713. # Usually this is used for a test that is missing OS support.
  714. #
  715. proc unsupported { message } {
  716.     record_test UNSUPPORTED $message
  717. }
  718.  
  719. #
  720. # Set up the values in the test_counts array (name and initial totals).
  721. #
  722. proc init_testcounts { } {
  723.     global test_counts test_names;
  724.     set test_counts(TOTAL,name) "testcases run"
  725.     set test_counts(PASS,name) "expected passes"
  726.     set test_counts(FAIL,name) "unexpected failures"
  727.     set test_counts(XFAIL,name) "expected failures"
  728.     set test_counts(XPASS,name) "unexpected successes"
  729.     set test_counts(WARNING,name) "warnings"
  730.     set test_counts(ERROR,name) "errors"
  731.     set test_counts(UNSUPPORTED,name) "unsupported tests"
  732.     set test_counts(UNRESOLVED,name) "unresolved testcases"
  733.     set test_counts(UNTESTED,name) "untested testcases"
  734.     set j "";
  735.  
  736.     foreach i [lsort [array names test_counts]] {
  737.     regsub ",.*$" "$i" "" i;
  738.     if { $i == $j } {
  739.         continue;
  740.     }
  741.     set test_counts($i,total) 0;
  742.     lappend test_names $i;
  743.     set j $i;
  744.     }
  745. }
  746.  
  747. #
  748. # Increment NAME in the test_counts array; the amount to increment can be
  749. # is optional (defaults to 1).
  750. #
  751. proc incr_count { name args } {
  752.     global test_counts;
  753.  
  754.     if { [llength $args] == 0 } {
  755.     set count 1;
  756.     } else {
  757.     set count [lindex $args 0];
  758.     }
  759.     if [info exists test_counts($name,count)] {
  760.     incr test_counts($name,count) $count;
  761.     incr test_counts($name,total) $count;
  762.     } else {
  763.     perror "$name doesn't exist in incr_count"
  764.     }
  765. }
  766.  
  767.  
  768. #
  769. # Create an exp_continue proc if it doesn't exist
  770. #
  771. # For compatablity with old versions.
  772. #
  773. global argv0
  774. if ![info exists argv0] {
  775.     proc exp_continue { } {
  776.     continue -expect
  777.     }
  778. }
  779.